MacFormat 1995 January/macformat-020.iso/Shareware City/Applications/Alpha.5.96 folder/Tcl/SystemCode/marks.tcl

Text File | 1994-08-20 | 4.2 KB | 196 lines | [TEXT/ALFA]

# ================================================================================
# Clear marks for front window.
#================================================================================
proc clearFileMarks {} {
    set nm [lindex [winNames -f] 0]

    foreach mk [getNamedMarks] {
        if {$nm == [lindex $mk 1]} {
            removeNamedMark -n [lindex $mk 0] -w [lindex $mk 1]
        }
    }
}


proc sortMarksFile {} {
    if {[askyesno "Really sort all marks?"] != "yes"} {return}

    set nm [lindex [winNames -f] 0]

    set mks {}
    foreach mk [getNamedMarks] {
        if {$nm == [lindex $mk 1]} {
            removeNamedMark -n [lindex $mk 0] -w [lindex $mk 1]
            lappend mks $mk
        }
    }

    foreach mk [lsort $mks] {
        set name [lindex $mk 0]
        set disp [lindex $mk 2]
        set pos [lindex $mk 3]
        set end [lindex $mk 4]

        setNamedMark $name $disp $pos $end
    }
}

# From Mark Nagata
proc zeroadd {num} {
    set mx [maxPos]
    set len [string length $mx]
    set num [format "%0${len}d" $num]
    return $num
}

proc orderMarks {} {
    if {[askyesno "Really reorder all marks?"] != "yes"} {return}

    set nm [lindex [winNames -f] 0]

    set wks {}
    foreach mk [getNamedMarks] {
        if {$nm == [lindex $mk 1]} {
            removeNamedMark -n [lindex $mk 0] -w $nm
            set name [lindex $mk 0]
            set disp [lindex $mk 2]
            set pos [lindex $mk 3]
            set end [lindex $mk 4]
            set pos [zeroadd $pos]
            set wk [list $pos $disp $name $end]
            lappend wks $wk
        }
    }

    foreach wk [lsort $wks] {
        set name [lindex $wk 2]
        set disp [lindex $wk 1]
        set pos [lindex $wk 0]
        set end [lindex $wk 3]

        setNamedMark $name $disp $pos $end
    }
}

#================================================================================
proc markFile {} {
    global mode

    set f [lindex [winNames -f] 0]

    watchCursor
    if {([lsearch [getNamedMarks] "*$f*"] >= 0) && [askyesno "Clear previous marks? "] == "yes"} {
        clearFileMarks
    }

    catch "${mode}MarkFile"
}

proc markAlphaCommands {} {
    set end [maxPos]
    set pos 0
    set l {}
    set num 0
    while {![catch {search -f 1 -r 1 -m 0 -i 1 {^• [a-z]+} $pos} res]} {
        set start [lindex $res 0]
        set end [lindex $res 1]
        set text [lindex [getText $start $end] 1]
        set inds($text) $start
        set pos [nextLineStart $end]
        incr num
        message "$num"
    }

    if {[info exists inds]} {
        foreach f [lsort [array names inds]] {
            setNamedMark $f $inds($f) $inds($f) $inds($f)
        }
    }
}

proc markIntro {} {
    set end [maxPos]
    set pos 0
    set l {}
    set num 0
    while {![catch {search -f 1 -r 1 -m 0 -i 0 {^== } $pos} res]} {
        set start [lindex $res 1]
        set end [expr [nextLineStart $start] - 1]
        set text [getText $start $end]
        set inds($text) [lineStart $start]
        set pos [nextLineStart $end]
        incr num
        message "$num"
    }

    if {[info exists inds]} {
        foreach f [lsort [array names inds]] {
            setNamedMark $f $inds($f) $inds($f) $inds($f)
        }
    }
}

# ================================================================================
# Simple mark stack implementation
# ================================================================================
proc pushMark {} {
    global markStack
    global markName

    set name mark$markName
    incr markName
    createTMark $name [getPos]
    set fileName [lindex [winNames -f] 0]
    set markStack [linsert $markStack 0 [list $fileName $name]]
    message [concat Mark [llength $markStack] Pushed]
}

proc popMark {} {
    global markStack
    if {[llength $markStack] == "0"} {
        message "The mark stack is empty!"
        return
    }
    set mark [lindex [lindex $markStack 0] 1]
    set markStack [lreplace $markStack 0 0]
    if {[catch {gotoTMark $mark}]} {
        popMark
        return
    }
    message [concat Mark [llength $markStack] Popped]
}


# Returns 'list' minus all top-level elements matching 'pat'.
# Used in 'closeHooks' to prune the mark stack.
proc removePat {list pat} {
    while 1 {
        set ind [lsearch $list $pat]
        if {$ind == "-1"} {return $list}
        set list [lreplace $list $ind $ind]
    }
}




#================================================================================
# Only works while in same file.
#================================================================================

proc pointToRegister {} {
    message "Letter?"
    createTMark [set c [getChar]] [getPos]
    message "Register '$c'"
}


proc jumpToRegister {} {
    message "Letter?"
    gotoTMark [set c [getChar]]
    message "Register '$c'"
}